#lang racket

(provide (all-defined-out))

(require "compiler.scm")

; 1. copy-file
(copy-file "parser.asm" "outputs/parser.asm" #t)

; 2. write transformer from Racket-sexp to fscheme-sexp
; (racket->fscheme "(not #t)")

(define testcases
  '("integers"
    "immediate_constants"
    "fxadd1"
    "fxsub1"
    "fixnum_char"
    "is_fixnum"
    "is_fxzero"
    "is_null"
    "is_boolean"
    "is_char"
    "not"
    "fxlognot"
    "if"
    "fx_add"
    "fx_sub"
    "fx_mul"
    "fxlogand_fxlogor"
    "fx_eq"
    "fx_lt"
    "fx_le"
    "fx_gt"
    "fx_ge"
    "binary_primitives"
    "let"
    "let_star"
    "procedures"
    "more_stack"
    "deeply_nested_procedures"
    "cons"
    "begin_implicit_begin"
    "set_car_cdr"
    "more_cons"
    "vectors"
    "more_vectors"
    "strings"))

(define (is-testcase filename)
  (if (member (substring filename 0 (- (string-length filename) 2)) testcases) #t #f))

; (is-testcase "if.s")

(define (testcase-file-list)
  (filter (lambda (p) (and (string-suffix? (path->string p) ".s")) (is-testcase (path->string p))) (directory-list "testcases")))

;(port->lines (open-input-file "testcases/and_or.s"))

;; Just like emit-program, but send generated asm to outfile
(define (compile-test-program expr-list filename)
  (define test-name (substring filename 8 (- (string-length filename) 6)))
  (let ([p (open-output-file filename #:exists 'replace)])
    (parameterize ([compile-port p])
      ;(emit-test-library)
      (emit-test-program expr-list test-name))
    (close-output-port p)))

;(map path->string (testcase-file-list))
;(compile-test-program '((not #f) (fixnum? 2)) "outputs/test.asm")

(define (real-exprs exprs) (filter (lambda (e) (not (string-prefix? e ";"))) exprs))

(define (write-test-file input-file)
  (define lines (port->lines (open-input-file (string-append "testcases/" input-file))))
  (define output-file (string-append "outputs/" input-file ".asm"))
  (define exprs (list))
  (define results (list))
  (define (lift-expr lst)
    (if (null? lst) exprs
        (begin (set! exprs (append exprs `(,(read (open-input-string (car lst))))))
               (lift-expr (cddr lst)))))
  (define (lift-result lst)
    (if (null? lst) results
        (begin (set! results (append results (list (cadr lst))))
               (lift-result (cddr lst)))))
  (begin
    (lift-expr (real-exprs lines))
    (lift-result (real-exprs lines))
    (compile-test-program exprs output-file)))

(map write-test-file (map path->string (testcase-file-list)))

#|

(define (write-test-file input-file)
  (define lines (port->lines (open-input-file input-file)))
  (define test-name '())
  (define exprs '())
  (define results '())
  (define (emit-test-data num expr result)
    (emit (string-append "sexp_" num ": .asciiz " (racket->fscheme expr))))
  (define (emit-test-datas n lst)
    (if (null? lst) '()
        (begin (emit-test-data n (first lst) (second lst))
               (emit-test-datas (+ n 1) (cddr lst)))))
  (define (lift-expr lst result)
    (if (null? lst) result
        (begin (set! result (append result (car lst)))
               (lift-expr (cddr lst) result))))
  (define (lift-result lst result)
    (if (null? lst) result
        (begin (set! result (append result (cadr lst)))
               (lift-expr (cddr lst) result))))

  (emit ".data  ")
  (emit-test-datas 1 lines)
  (emit-test-program exprs test-name)
  (emit ".text  ")
  (emit ".globl test_<n> ")
  (emit "    la   $a0, sexp_<n> ")
  (emit "    jal  L_scheme_entry_<n> "))

;read string from file testcases/... .s
;split into transform(input), output
;emit:
;.data
;sexp_<n>: .asciiz transform(input)  " => \"

;call (emit-test-program expr-list testname)

;emit:
;.text
;.globl test_<n>
;    la   $a0, sexp_<n>
;    jal  parse_sexp

;    jal  L_scheme_entry_<n>

;    move $a0, $v0
;    jal  print_sexp

;    if equal_sexp   [success] else [fail]


-1.1 integers

-1.2 immediate-constants

-1.3 fxadd1
-1.3 fxsub1
-1.3 fixnum-char
-1.3 is-fixnum
-1.3 is-fxzero
-1.3 is-null
-1.3 is-boolean
-1.3 is-char
-1.3 not
-1.3 fxlognot

1.4 if

1.5 fx-add
1.5 fx-sub
1.5 fx-mul
1.5 fxlogand-fxlogor
1.5 fx-eq
1.5 fx-lt
1.5 fx-le
1.5 fx-gt
1.5 fx-ge
1.5 if
1.5 binary-primitives

1.6 let
1.6 let-star
1.6 let-let-star

1.7 procedures
1.7 more-stack

1.8 deeply-nested-procedures

1.9.1 cons
1.9.1 begin-implicit-begin
1.9.1 set-car-set-cdr
1.9.1 more-cons

1.9.2 vectors
1.9.2 more-vectors

1.9.3 strings

2.1 procedure?
2.1 applying thunks
2.1 parameter passing
2.1 closures

2.2 set!

2.3 complex constants

2.4.1 letrec
2.4.1 letrec*

2.4.2 and/or
2.4.2 when/unless

2.4 cond

2.6 vararg not using rest argument
2.6 vararg using rest argument

2.8 symbols

2.9 exit
2.9 S_error
2.9 S_log

3.1 vector

3.2 error
3.2 apply error
3.2 arg-check for fixed-arg procedures
3.2 arg-check for var-arg procedures

3.3 string-set! errors
3.3 string errors

3.4 nontail apply
3.4 tail apply

4.1.1 remainder/modulo/quotient
4.1.2 write-char
4.1.3 write/display

4.2.1 inner define
4.2.2 eof-object

4.2.3 read-char

4.3 tokenizer
4.3 reader

5.1 tokenizer
5.1 reader

5.2 overflow
5.3 call/cc

5.6 fxmodulo
|#
